home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Tele / S / SetSoundVol Folder / SetSoundVol RCMD.p < prev    next >
Encoding:
Text File  |  1991-03-03  |  12.1 KB  |  396 lines  |  [TEXT/PJMM]
  1. unit SetSoundVol;
  2.  
  3. { White Knight RCMD to set the speaker volume. }
  4.  
  5. { THINK Pascal 3.0.1 }
  6.  
  7. { Aron Roberts }
  8. { Version 1.1, 3 March 1991 }
  9. { aron@garnet.berkeley.edu, aron@ucbgarne.bitnet }
  10.  
  11. interface
  12.  
  13.  
  14. {_______________________________________________________________ }
  15. {                                                                                                }
  16. {    Instructions to compile an RCMD with Think Pascal                                    }
  17. {                                                                                                }
  18. {    1) Open a new project                                                                    }
  19. {    2) Remove Runtime.lib                                                                    }
  20. {    3) Add DRVRRuntime.lib                                                                    }
  21. {    4) Set project type to a Code Resouce under Project->Set Project Type...            }
  22. {    5) You must enter "RCMD" in the Type                                                    }
  23. {    6) You must give an ID such as between 200 and 300                                    }
  24. {    7) Set the Attribute to Purgeable                                                        }
  25. {    8) Select Build Code Resource under Project                                            }
  26. {                                                                                                }
  27. {    That's IT!!!  Now copy the RCMD into the WK Procedure source file that will         }
  28. {    use the RCMD!                                                                            }
  29. {_______________________________________________________________ }
  30.  
  31. {RCMD Structure converted from Think C to Think Pascal by Doug Acker}
  32. {Modified and updated by Robert A. Daniel}
  33. {If you find any errors, please send GEnie mail to B.DANIEL}
  34.  
  35.     type
  36.  
  37. {Numeric}
  38. {The parameter Long26 is an}
  39. {array of 234 long integers , each containing the current values of the}
  40. { numeric variables A1% to Z9% in that order . The structure is ordered }
  41. {so that the first 26 elements are A1% through Z1% , the next 26 elements }
  42. {would be A2% through Z2% , and the last}
  43.  
  44.         Long26 = array[1..234] of longint;
  45.         UVAR = ^XRec;
  46.         XRec = record                {Record to the numeric Value of A% to Z%}
  47.                 x: Long26;
  48.             end;
  49.  
  50.  
  51.  
  52. {The parameter VarType is an array of 234 Pascal type strings of 134}
  53. {characters each ( including the length byte ) , containing the current contents of the}
  54. {stringvariables A1$ to Z9$ in that order . The structure is ordered so that}
  55. { the first 26 elements are A1$ through Z1$ , the next 26 elements would be }
  56. {A2$ through Z2$, and the last 26 elements would be A9$ through Z9$. }
  57.  
  58.         Str134 = string[134];
  59.         VarType = array[1..234] of Str134;
  60.         USTR = ^yRec;
  61.         yRec = record                {Record that points to the string of A$ to Z$}
  62.                 y: VarType;
  63.             end;
  64.  
  65.  
  66.         WKParam = array[1..8350] of byte;
  67.         WKPtr = ^WKPtrRec;
  68.         WKPtrRec = record                {Record that points to XXXPARAM Bytes}
  69.                 theval: WKParam;
  70.             end;
  71.  
  72.         byte20 = array[1..20] of byte;
  73.         bytePtr = ^byteRec;
  74.         byteRec = record        {Record structure for the  GETGROUP/SETGROUP and GETBOX/SETBOX}
  75.                                  {procedure commands containing 20bytes}
  76.                 b: byte20;
  77.             end;
  78.  
  79.  
  80.  
  81.         Buff1K = array[1..1024] of byte;
  82.         Buff1KPtr = ^Buff1Rec;
  83.         Buff1Rec = record                    {1K buffer free to use if free memory isn't known or}
  84.                 data: Buff1K;                        {known memory is small}
  85.             end;
  86.  
  87.  
  88.         Buff2K = array[1..2048] of byte;
  89.         Buff2KPtr = ^Buff2Rec;
  90.         Buff2Rec = record                    {2K buffer free to use if free memory isn't known or}
  91.                 data: Buff2K;                        {know memory is small}
  92.             end;
  93.  
  94.  
  95.         FilterType = array[1..256, 1..2] of byte;
  96.         FilterPtr = ^FilterRec;
  97.         FilterRec = record        {Record to the filters for the terminal/capture/Protocol filters}
  98.                                  {256 ASCII codes, second byte: 0=pass,1=strip, 2=replace, 3=enemuerate}
  99.                 f: FilterType;
  100.             end;
  101.  
  102.  
  103.         FlagPtr = ^FlagsRec;
  104.         FlagsRec = record        {Used by the IF YES and IF NO procedure commands, 0=no,1=yes}
  105.                                  {Used by the IF ERROR and IF NO ERROR procedure commands, 0=no, 1=yes}
  106.                 isyes: byte;
  107.                 iserr: byte;
  108.             end;
  109.  
  110.  
  111.         PathType = array[1..124] of byte;
  112.         PathPtr = ^Byte124;
  113.         Byte124 = record                {The path to Received File Destination path}
  114.                 thepath: PathType;
  115.             end;
  116.  
  117.  
  118.         RGBColorRec = record            {IM V page 48}
  119.                 red: integer;
  120.                 green: integer;
  121.                 blue: integer;
  122.             end;
  123.  
  124.  
  125.  
  126.         passvars = record
  127.                 uservar: UVAR;                  {A% to Z%  array of 26 longint}
  128.                 userstr: USTR;                {A$ to Z$  arrray of 26 Str255}
  129.                 params1: WKPtr;                {values to use with the GETPARAM or PUTPARAM  array of 8350 bytes}
  130.                 reserved1: Handle;            {Reserved}
  131.                 reserved2: longint;            {Reserved}
  132.                 reserved3: longint;            {Reserved}
  133.                 reserved4: longint;            {Reserved}
  134.                 reserved5: integer;            {Reserved}
  135.                 userbl1: ^ParamBlockRec;    {IM II-98  I/O using the USERXXXX1 procedure commands}
  136.                 userbl2: ^ParamBlockRec;    {IM II-98  I/O using the USERXXXX2 procedure commands}
  137.                 pblock: ^ParamBlockRec;    {IM II-98  I/O using the Serial In port}
  138.                 qblock: ^ParamBlockRec;    {IM II-98  I/O using the Serial Out port}
  139.                 radiogroup: bytePtr;            {Record structure for the  GETGROUP/SETGROUP}
  140.                                         {procedure commands containing 20 bytes}
  141.                 checkbox: bytePtr;            {Record structure for the GETBOX/SETBOX procedure}
  142.                                         {commands containing 20bytes}
  143.                 buff1K: Buff1KPtr;            {1K buffer for own use allocated by WK}
  144.                 buff2K: Buff2KPtr;            {2K buffer for own use allocated by WK}
  145.                 tfilter: FilterPtr;                {Terminal Filter}
  146.                 ffilter: FilterPtr;                {File Capture Filter}
  147.                 filter: FilterPtr;                {Protocol Transfer Filter}
  148.                 theflags: FlagPtr;            {IF YES/NO amd IF ERROR/NO ERROR}
  149.                 recpath: PathPtr;            {Recived File path dest - up to 123 byte string}
  150.                 forecolor: RGBColorRec;        {terminal window foreground}
  151.                 backcolor: RGBColorRec;    {terminal window background}
  152.                 hilcolor: RGBColorRec;        {terminal window hilite}
  153.                 sbfore: RGBColorRec;        {status barforeground}
  154.                 sbback: RGBColorRec;        {status bar background}
  155.                 sbhil: RGBColorRec;            {status bar hilite}
  156.                 phonefore: RGBColorRec;    {phonebook foreground}
  157.                 phoneback: RGBColorRec;    {phonebook background}
  158.                 phonehil: RGBColorRec;         {phoneboox hilite}
  159.                 indfore: RGBColorRec;         {File Transfer Indicator foreground}
  160.                 indback: RGBColorRec;         {File Transfer indicator background}
  161.                 rlefore: RGBColorRec;        {RLE graphics foreground}
  162.                 rleback: RGBColorRec;        {RLE grpahic background}
  163.                 WKsWindow: WindowPeek;    {IM I-304 (WindowPeek/CWindowPeek) ptr to terminal window}
  164.                 DoUpdate: integer;            {If RCMD draws in gp, set to nozero so RR will redraw the term }
  165.                                          {window when RCMD is done }
  166.                 Transfer: Rect;                {IM I-141 last position of file transfer window}
  167.                 version: integer;                {version number of structure, currently = 0}
  168.             end;
  169.         Rptr = ^passvars;                {Pointer to above structure}
  170.  
  171.  
  172.  
  173. {_______________________________________________________________ }
  174.  
  175. {Main RCMD code}
  176.  
  177.     procedure main (params: Rptr);  {pass the pointer to the structure}
  178.  
  179. implementation
  180.  
  181.     procedure main;
  182.  
  183.         const
  184.  
  185.       { Elements in the array of White Knight integer variables }
  186.       { from A1% to Z9%: }
  187.  
  188.             position_of_S9% = 227; { (26 * 8) + 19 }
  189.             position_of_S8% = 201; { (26 * 7) + 19 }
  190.             position_of_S7% = 175; { (26 * 6) + 19 }
  191.  
  192.         type
  193.  
  194.             volClikByteType = byte;
  195.             volClikBytePointerType = ^volClikByteType;
  196.  
  197.         var
  198.  
  199.             pointerToPRAMRecord: SysPPtr;
  200.             volClikByte: volClikByteType;
  201.             volClikBytePointer: volClikBytePointerType;
  202.  
  203.             PRAMErrorReturn: integer;
  204.             previousSpeakerVolume: integer;
  205.             requestedSpeakerVolume: integer;
  206.  
  207. { ----- }
  208.  
  209.         procedure getPRAM;
  210.  
  211.         begin
  212.  
  213.       { Get a copy of the settings in parameter RAM, and store this copy }
  214.       { in a record structure reflecting the organization of these settings. }
  215.             pointerToPRAMRecord := GetSysPPtr;
  216.  
  217.       { Temporarily store the value of the one-byte portion of }
  218.       { parameter RAM which stores the speaker volume, double-click time, }
  219.       { caret-blink time, and other settings. }
  220.             volClikByte := pointerToPRAMRecord^.volClik;
  221.  
  222.         end; { PROCEDURE getPRAM }
  223.  
  224. { ----- }
  225.  
  226.         procedure setPRAM (speakerVolume: integer);
  227.  
  228.         begin
  229.  
  230.       { Offset 5 from the high order bit of the volClikByte is bit 10. }
  231.       { Offset 6 from the high order bit of the volClikByte is bit  9. }
  232.       { Offset 7 from the high order bit of the volClikByte is bit  8. }
  233.  
  234.             with pointerToPRAMRecord^ do
  235.                 begin
  236.  
  237.           { Set bits 8-10 (at offsets 5-7) of the volClikByte to reflect }
  238.           { the new requested speaker volume. }
  239.  
  240.           { This is a hokey way to diddle bits, but it's very clear}
  241.           { and it works. }
  242.  
  243.                     case speakerVolume of
  244.                         7: {111}
  245.                             begin
  246.                                 bitSet(Ptr(volClikBytePointer), 5);
  247.                                 bitSet(Ptr(volClikBytePointer), 6);
  248.                                 bitSet(Ptr(volClikBytePointer), 7);
  249.                             end;
  250.                         6: {110}
  251.                             begin
  252.                                 bitSet(Ptr(volClikBytePointer), 5);
  253.                                 bitSet(Ptr(volClikBytePointer), 6);
  254.                                 bitClr(Ptr(volClikBytePointer), 7);
  255.                             end;
  256.                         5: {101}
  257.                             begin
  258.                                 bitSet(Ptr(volClikBytePointer), 5);
  259.                                 bitClr(Ptr(volClikBytePointer), 6);
  260.                                 bitSet(Ptr(volClikBytePointer), 7);
  261.                             end;
  262.                         4: {100}
  263.                             begin
  264.                                 bitSet(Ptr(volClikBytePointer), 5);
  265.                                 bitClr(Ptr(volClikBytePointer), 6);
  266.                                 bitClr(Ptr(volClikBytePointer), 7);
  267.                             end;
  268.                         3: {011}
  269.                             begin
  270.                                 bitClr(Ptr(volClikBytePointer), 5);
  271.                                 bitSet(Ptr(volClikBytePointer), 6);
  272.                                 bitSet(Ptr(volClikBytePointer), 7);
  273.                             end;
  274.                         2: {010}
  275.                             begin
  276.                                 bitClr(Ptr(volClikBytePointer), 5);
  277.                                 bitSet(Ptr(volClikBytePointer), 6);
  278.                                 bitClr(Ptr(volClikBytePointer), 7);
  279.                             end;
  280.                         1: {001}
  281.                             begin
  282.                                 bitClr(Ptr(volClikBytePointer), 5);
  283.                                 bitClr(Ptr(volClikBytePointer), 6);
  284.                                 bitSet(Ptr(volClikBytePointer), 7);
  285.                             end;
  286.                         0: {000}
  287.                             begin
  288.                                 bitClr(Ptr(volClikBytePointer), 5);
  289.                                 bitClr(Ptr(volClikBytePointer), 6);
  290.                                 bitClr(Ptr(volClikBytePointer), 7);
  291.                             end;
  292.                     end; {case}
  293.  
  294.                 end; {with pointerToPRAMRecord^ do}
  295.  
  296.       { Change the VolClick byte in our memory copy of the parameter RAM }
  297.       { to reflect the changes made to our copy of this byte, above. }
  298.             pointerToPRAMRecord^.volClik := volClikBytePointer^;
  299.  
  300.         end; { PROCEDURE setPRAM }
  301.  
  302. { ----- }
  303.  
  304.         function writePRAM: integer;
  305.  
  306.             var
  307.                 OSError: OSErr;
  308.  
  309.         begin
  310.  
  311.       { Write the pointerToPRAMRecord (of type SysPPtr), containing }
  312.       { the current settings for parameter RAM in low memory, to the}
  313.       { battery-backed parameter RAM in the clock chip. }
  314.             OSError := WriteParam;
  315.  
  316.       { Return the error code from this operation, if any. }
  317.             if OSError <> noErr then   {noErr is a constant set to 0}
  318.                 writePRAM := OSError
  319.             else
  320.                 writePRAM := noErr;
  321.  
  322.         end; { FUNCTION writePRAM }
  323.  
  324. { ----- }
  325.  
  326.         procedure cleanUp;
  327.  
  328.         begin
  329.  
  330.             disposPtr(Ptr(volClikBytePointer));
  331.             disposPtr(Ptr(pointerToPRAMRecord));
  332.  
  333.         end; { PROCEDURE cleanUp }
  334.  
  335. { ----- }
  336.  
  337.     begin { PROCEDURE main }
  338.  
  339.     { Assign the value of S9% to the requested new SpeakerVolume. }
  340.         requestedSpeakerVolume := params^.uservar^.x[position_of_S9%];
  341.  
  342.         GetSoundVol(previousSpeakerVolume);
  343.         if previousSpeakerVolume = requestedSpeakerVolume then
  344.             begin
  345.         {return 0 in S7% to indicate success }
  346.                 params^.uservar^.x[position_of_S7%] := 0;
  347.        { Return the previous sound volume in S8% }
  348.                 params^.uservar^.x[position_of_S8%] := previousSpeakerVolume;
  349.         { Return without changing the speaker volume. }
  350.                 exit(main);
  351.             end;
  352.  
  353.     { If the requested speaker volume is outside the valid range }
  354.     { of 0-7, then return -1 in S7% to indicate the speaker volume }
  355.     { could not be changed. }
  356.         if (requestedSpeakerVolume < 0) or (requestedSpeakerVolume > 7) then
  357.             params^.uservar^.x[position_of_S7%] := -1
  358.  
  359.         else
  360.  
  361.             begin
  362.  
  363.        { Return the previous sound volume in S8% }
  364.                 GetSoundVol(previousSpeakerVolume);
  365.                 params^.uservar^.x[position_of_S8%] := previousSpeakerVolume;
  366.  
  367.         { Change the sound volume to the value specified in S9% }
  368.                 SetSoundVol(requestedSpeakerVolume);
  369.  
  370.         { If the current speaker volume was not changed to the }
  371.         { new volume requested, then return -1 in S7% to indicate failure}
  372.         { and exit without writing anything to parameter RAM (PRAM). }
  373.                 getSoundVol(previousSpeakerVolume); { actually the current volume }
  374.                 if previousSpeakerVolume <> requestedSpeakerVolume then
  375.                     begin
  376.                         params^.uservar^.x[position_of_S7%] := -1;
  377.                         exit(main);
  378.                     end;
  379.  
  380.         { Write the new speaker volume to PRAM. }
  381.                 getPRAM;
  382.                 setPRAM(requestedSpeakerVolume);
  383.                 PRAMErrorReturn := writePRAM;
  384.  
  385.         { Return the result code from attempting to write }
  386.         { the new speaker volume to PRAM in S7%. }
  387.         { The result code should be either 0 (success) or -87 (failure). }
  388.                 params^.uservar^.x[position_of_S7%] := PRAMErrorReturn;
  389.  
  390.         { Dispose of pointers. }
  391.                 cleanUp;
  392.  
  393.             end;
  394.  
  395.     end;
  396. end.